home *** CD-ROM | disk | FTP | other *** search
/ Shareware Grab Bag / Shareware Grab Bag.iso / 002 / bluebery.arc / CALULATE.BAS (.txt) < prev    next >
Encoding:
GW-BASIC  |  1985-06-29  |  3.8 KB  |  151 lines
  1. 5  CLS:KEY OFF:SCREEN 0,0,0:WIDTH 80:CLEAR:FOR I=1 TO 10:KEY I,"":NEXT:KEY 2,"GOTO 60"+CHR$(13):KEY 10,"RUN"+CHR$(34)+"BLUEMENU"+CHR$(34)+CHR$(13):LIST 10-57
  2. 10  '*****************  ELECTRONIC CALCULATOR MODE!  ***************************
  3. 12  'KEYTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENCLOSE
  4. 14  'OPEN                     SIMPLE CALCULATOR PROGRAM                           OPEN
  5. 16  'OPEN This simple program will run in SCREEN 0,0,0 WIDTH 40 in either mono-   OPEN
  6. 18  'OPEN chrome or color.  The program has been expanded to show the structure   OPEN
  7. 20  'OPEN of multiple statements.  Some of the basic routines may be applicable   OPEN
  8. 22  'OPEN to your programming efforts. Note the use of INPUT$(n) in the RESPONSE  OPEN
  9. 24  'OPEN routine. This is an interesting programming feature.  You may increase  OPEN
  10. 26  'OPEN the screen width for use with a monochrome monitor, by changing the 40  OPEN
  11. 28  'OPEN to 80 in line 160. This program, or any part, may be used without any   OPEN
  12. 30  'OPEN license or attribution.   (c)  G I N A C O  -- 1983    Ver 5.1/160/320  OPEN
  13. 32  'SCREENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENLOAD
  14. 55  '        *****  < F2 > to RUN  *******  < F10 > For BLUEMENU  *****
  15. 57  ' ====== To avoid DOCUMENTATION BOX each time, REM or DELETE  line 5 ======
  16. 60  CLS:SCREEN 0,0,0:WIDTH 80:CLEAR:FOR I=1 TO 10:KEY I,"":NEXT
  17. 100  CLS
  18. 250  CLS
  19. 260  SCREEN 0,0,0
  20. 270  WIDTH 80
  21. 280  CLEAR
  22. 290  FOR I! = 1 TO 10
  23. 300    KEY I!,""
  24. 310  NEXT
  25. 320  S$ = "###,###.##"
  26. 330  X! = 0
  27. 340  Y! = 0
  28. 350  COLOR 7,0
  29. 360  SCREEN 0,0,0
  30. 370  WIDTH 40
  31. 380  LOCATE 10,10
  32. 390  PRINT "WHAT MODE?"
  33. 400  CLS
  34. 410  LOCATE 12,1
  35. 420  PRINT " -- ADD, SUBTRACT, MULTIPLY, DIVIDE -- "
  36. 430  LOCATE 14,10
  37. 440  PRINT "SELECT A, S, M, OR D"
  38. 450  LOCATE 16,1
  39. 460  PRINT SPC( 39)
  40. 470  LOCATE 16,16
  41. 480  INPUT A$
  42. 490  IF (A$ = "A" OR A$ = "a") THEN X! = 1
  43. 500  IF (A$ = "S" OR A$ = "s") THEN X! = 2
  44. 510  IF (A$ = "M" OR A$ = "m") THEN X! = 3
  45. 520  IF (A$ = "D" OR A$ = "d") THEN X! = 4
  46. 530  IF X! < 1 OR X! > 4 THEN 540 ELSE 600
  47. 540  CLS
  48. 550  COLOR 2,0
  49. 560  LOCATE 10,8
  50. 570  PRINT "A ,D, S OR M ONLY PLEASE"
  51. 580  COLOR 7,0
  52. 590  GOTO 430
  53. 600  ON X! GOTO 610,970,1150,790
  54. 610  REM ******************** ADDITION ROUTINE *****************************
  55. 620  CLS
  56. 630  LOCATE 6,16
  57. 640  PRINT "A D D I T I O N"
  58. 650  LOCATE 8,12
  59. 660  INPUT "1st NUMBER  ",AA!
  60. 670  LOCATE 10,12
  61. 680  INPUT "ADD         ",BB!
  62. 690  CC! = AA! + BB!
  63. 700  LOCATE 12,22
  64. 710  PRINT "_________"
  65. 720  LOCATE 14,14
  66. 730  COLOR 4,0
  67. 740  PRINT "SUM IS ";
  68. 750  PRINT USING S$;CC!
  69. 760  COLOR 7,0
  70. 770  GOSUB 1330
  71. 780  ON Y! GOTO 620,100
  72. 790  REM ******************** DIVISION ROUTINE *****************************
  73. 800  CLS
  74. 810  LOCATE 6,16
  75. 820  PRINT "D I V I S I O N"
  76. 830  LOCATE 8,13
  77. 840  INPUT "1st NUMBER  ",AA!
  78. 850  LOCATE 10,13
  79. 860  INPUT "DIVIDED BY  ",BB!
  80. 870  CC! = AA! / BB!
  81. 880  LOCATE 12,22
  82. 890  PRINT "_________"
  83. 900  LOCATE 14,7
  84. 910  COLOR 2,0
  85. 920  PRINT "QUOTIENT IS ";
  86. 930  PRINT USING S$;CC!
  87. 940  COLOR 7,0
  88. 950  GOSUB 1330
  89. 960  ON Y! GOTO 800,100
  90. 970  REM ******************** SUBTRACTION ROUTINE **************************
  91. 980  CLS
  92. 990  LOCATE 6,15
  93. 1000  PRINT "S U B T R A C T I O N"
  94. 1010  LOCATE 8,12
  95. 1020  INPUT "1st NUMBER  ",AA!
  96. 1030  LOCATE 10,12
  97. 1040  INPUT "SUBTRACT    ",BB!
  98. 1050  CC! = AA! - BB!
  99. 1060  LOCATE 12,22
  100. 1070  PRINT "_________"
  101. 1080  LOCATE 14,6
  102. 1090  COLOR 2,0
  103. 1100  PRINT "DIFFERENCE IS ";
  104. 1110  PRINT USING S$;CC!
  105. 1120  COLOR 7,0
  106. 1130  GOSUB 1330
  107. 1140  ON Y! GOTO 980,100
  108. 1150  REM ******************** MULTIPLY ROUTINE *****************************
  109. 1160  CLS
  110. 1170  LOCATE 6,8
  111. 1180  PRINT "M U L T I P L I C A T I O N"
  112. 1190  LOCATE 8,12
  113. 1200  INPUT "1st NUMBER  ",AA!
  114. 1210  LOCATE 10,12
  115. 1220  INPUT "TIMES       ",BB!
  116. 1230  CC! = AA! * BB!
  117. 1240  LOCATE 12,22
  118. 1250  PRINT "_________"
  119. 1260  LOCATE 14,8
  120. 1270  COLOR 3,0
  121. 1280  PRINT "PRODUCT IS ";
  122. 1290  PRINT USING S$;CC!
  123. 1300  COLOR 7,0
  124. 1310  GOSUB 1330
  125. 1320  ON Y! GOTO 1160,100
  126. 1330  REM ******************* RESPONSE SUBROUTINE ****************************
  127. 1340  LOCATE 20,10
  128. 1350  PRINT "PRESS SPACE BAR FOR REPEAT"
  129. 1360  LOCATE 22,10
  130. 1370  PRINT "PRESS ESC FOR NEW FUNCTION"
  131. 1380  LOCATE 24,20
  132. 1390  RSP$ = INPUT$(1)
  133. 1400  IF ( ASC(RSP$) = 27 OR ASC(RSP$) = 32) THEN 1410 ELSE 1480
  134. 1410  IF ASC(RSP$) = 27 THEN Y! = 2
  135. 1420  IF ASC(RSP$) = 32 THEN Y! = 1
  136. 1430  RETURN
  137. 1440  LOCATE 22,1
  138. 1450  PRINT SPC( 254)
  139. 1460  GOTO 1340
  140. 1470  RETURN
  141. 1480  LOCATE 24,11
  142. 1490  PRINT "ESC OR SPACE-BAR PLEASE";
  143. 1500  FOR I! = 1 TO 2000
  144. 1510  NEXT
  145. 1520  LOCATE 23,1
  146. 1530  PRINT SPC( 79)
  147. 1540  GOTO 1340
  148. 1550  END
  149. 65000  REM ===== SAVE ROUTINE =====
  150. 65100  SAVE"B:CALULATE.BAS"
  151.